home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Text / WASTE / WASTE 1.1.2 Distribution / Demo Source / WEDemoAbout.p < prev    next >
Encoding:
Text File  |  1995-10-12  |  2.8 KB  |  144 lines  |  [TEXT/CWIE]
  1. unit WEDemoAbout;
  2.  
  3. { WASTE DEMO PROJECT: }
  4. { About Boxes }
  5.  
  6. { Copyright © 1993-1995 Marco Piovanelli }
  7. { All Rights Reserved }
  8.  
  9. interface
  10.     uses
  11.         WEDemoIntf;
  12.  
  13.     procedure DoAboutBox (dialogID: Integer);
  14.  
  15. implementation
  16.     uses
  17.         DialogUtils;
  18.  
  19.     const
  20.  
  21. { dialog item numbers }
  22.  
  23.         kItemTextPane = 3;
  24.  
  25.     var
  26.  
  27. { static variables }
  28.  
  29.         sBoxPainter: UserItemUPP;
  30.  
  31.     function WETextBox (textResID: Integer;
  32.                                     {const} var bounds: Rect;
  33.                                     alignment: Integer): OSErr;
  34.         label
  35.             1;
  36.         var
  37.             we: WEReference;
  38.             longBounds: LongRect;
  39.             hText: Handle;
  40.             hStyles: Handle;
  41.             saveTextState, saveStylesState: SignedByte;
  42.             err: OSErr;
  43.     begin
  44.         we := nil;
  45.         hText := nil;
  46.         hStyles := nil;
  47.  
  48. { create a new WE instance }
  49.         WERectToLongRect(bounds, longBounds);
  50.         err := WENew(longBounds, longBounds, 0, we);
  51.         if (err <> noErr) then
  52.             goto 1;
  53.  
  54. { set the alignment style }
  55.         WESetAlignment(alignment, we);
  56.  
  57. { load the styl resource and make it unpurgeable }
  58.         hStyles := GetResource(kTypeStyles, textResID);
  59.         err := ResError;
  60.         if (err <> noErr) then
  61.             goto 1;
  62.         saveStylesState := HGetState(hStyles);
  63.         HNoPurge(hStyles);
  64.  
  65. { load the TEXT resource and lock it }
  66.         hText := GetResource(kTypeText, textResID);
  67.         err := ResError;
  68.         if (err <> noErr) then
  69.             goto 1;
  70.         saveTextState := HGetState(hText);
  71.         HLockHi(hText);
  72.  
  73. { insert the text }
  74.         err := WEInsert(hText^, GetHandleSize(hText), StScrpHandle(hStyles), nil, we);
  75.         if (err <> noErr) then
  76.             goto 1;
  77.  
  78. { clear result code }
  79.         err := noErr;
  80.  
  81. 1:
  82. { clean up }
  83.         if (hText <> nil) then
  84.             HSetState(hText, saveTextState);
  85.  
  86.         if (hStyles <> nil) then
  87.             HSetState(hStyles, saveStylesState);
  88.  
  89.         WEDispose(we);
  90.  
  91. { return result code }
  92.         WETextBox := err;
  93.  
  94.     end;  { WETextBox }
  95.  
  96.     procedure DrawUserItem (dialog: DialogRef;
  97.                                     item: Integer);
  98.         var
  99.             r: Rect;
  100.     begin
  101.  
  102. { draw the text, centered, in the item rect }
  103.         GetDialogItemRect(dialog, item, r);
  104.         if (WETextBox(GetWRefCon(dialog), r, weCenter) <> noErr) then
  105.             ;
  106.     end;  { DrawUserItem }
  107.  
  108.     procedure DoAboutBox (dialogID: Integer);
  109.         var
  110.             aboutBox: DialogRef;
  111.             itemHit: Integer;
  112.     begin
  113.  
  114. { get about box }
  115.         aboutBox := GetNewDialog(dialogID, nil, WindowRef(-1));
  116.         if (aboutBox = nil) then
  117.             Exit(DoAboutBox);
  118.  
  119. { install a user item drawing procedure for the text pane }
  120.         if (sBoxPainter = nil) then
  121.             sBoxPainter := NewUserItemProc(@DrawUserItem);
  122.         SetDialogItemProc(aboutBox, kItemTextPane, sBoxPainter);
  123.  
  124. { store ID of TEXT/styl pair (= ID of dialog template) in dialog refCon }
  125.         SetWRefCon(aboutBox, dialogID);
  126.  
  127. { put up the dialog }
  128. {$IFC NOT UNDEFINED THINK_PASCAL}
  129.         SetCursor(arrow);
  130. {$ELSEC}
  131.         SetCursor(qd.arrow);
  132. {$ENDC}
  133.         ShowWindow(aboutBox);
  134.         SetPort(aboutBox);
  135.  
  136. { wait for a click }
  137.         ModalDialog(GetMyStandardDialogFilter, itemHit);
  138.  
  139. { bring down the dialog }
  140.         DisposeDialog(aboutBox);
  141.  
  142.     end;  { DoAboutBox }
  143.  
  144. end.